home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-06
/
segue.exe
/
ALL_DEMO.PRG
next >
Wrap
Text File
|
1991-10-28
|
6KB
|
334 lines
*.............................................................................
* Program Name: ALL_DEMO.PRG Copyright: HRF Associates, Inc.
* Date Created: 01/16/91 Language: Clipper
* Time Created: 11:45:39 Author: Bob Fogle
*.............................................................................
PARAMETERS mSVC
mLASTCOLOR = SETCOLOR()
mLASTSCREEN = SAVESCREEN(00,00,24,79)
mLASTCURROW = ROW()
mLASTCURCOL = COL()
NOCOLOR="W/N,N+/W,,,W+/N"
mPARAN='()'
end_flag = .F.
mCNT=.F.
SET wrap ON
SET message TO 23 center
byy=10
byylen=14
byywidth=10
msupno=0
IF FILE("DEMO.DBF")
sele 1
use demo
go bott
ENDI
LCHOICE=0
DO WHILE .T.
SETCOLOR(if(iscolor()=.F.,NOCOLOR,"BG+/B,B/W+,,,W+/B"))
CLEAR
xx=3
if msupno<>1
@ xx, 3 SAY "Select SEGUE API to demo:"
else
@ xx, 3 SAY "Select SEGUE SUPPLEMENT FUNCTION to demo:"
endi
xx=xx+2
DO CASE
CASE mSVC=="BD"
DO BD_DEMO
CASE mSVC=="CT"
DO CT_DEMO
CASE mSVC=="DR"
DO DR_DEMO
CASE mSVC=="FL"
DO FL_DEMO
CASE mSVC=="FS"
DO FS_DEMO
CASE mSVC=="MG"
DO MG_DEMO
CASE mSVC=="PR"
DO PR_DEMO
CASE mSVC=="SZ"
DO SZ_DEMO
CASE mSVC=="TT"
DO TT_DEMO
CASE mSVC=="WE"
DO WE_DEMO
CASE mSVC=="BDsup"
DO BDsup
CASE mSVC=="CTsup"
DO CTsup
CASE mSVC=="DRsup"
DO DRsup
CASE mSVC=="FLsup"
DO FLsup
CASE mSVC=="FSsup"
DO FSsup
CASE mSVC=="MGsup"
DO MGsup
CASE mSVC=="PRsup"
DO PRsup
CASE mSVC=="SZsup"
DO SZsup
CASE mSVC=="TTsup"
DO TTsup
CASE mSVC=="WEsup"
DO WEsup
ENDCASE
IF end_flag
@ mLASTCURROW-2,mLASTCURCOL
RESTSCREEN(00,00,24,79,mLASTSCREEN)
SETCOLOR(mLASTCOLOR)
close all
msupno=0
RETURN
ENDIF
ENDDO
PROCEDURE MDISP
yy=byy
yylen=byylen
yywidth=byywidth
@ 00,00 TO 24,79 DOUBLE
if msupno>1
@ 05,48 TO 18,77
@ 05,55 SAY " SEGUE SUPPLEMENT "
sbyy=50
sbxx=6
syylen=12
endi
msflag=.f.
for i=1 to bcnt
@ xx,yy PROMPT mPROMPT[i] MESSAGE mAPI[i]
xx=xx+1
if msupno>1.and.i>=msupno-1
if .not.msflag
xx = sbxx
yy = sbyy
msflag=.t.
endi
if xx = sbxx+syylen
xx = sbxx
yy = yy+yywidth+1
endi
else
if i=15
xx=xx-yylen
yy=yy+yywidth
endi
if i=29
xx=xx-yylen
yy=yy+yywidth
endi
endi
next
return
PROCEDURE INTRO
PUBLIC XX
CLEAR
xx=ROW()
xx=xx+1
if msupno=0 // NPRCHECK TO SEE WHERE SEGUE SUPPLEMENTS START
@ xx, 0 SAY "Demo for "+mPROMPT[mCHOICE]+mPARAN+', '+mAPI[mCHOICE]+" API"
else
@ xx, 0 SAY "Demo for "+mPROMPT[mCHOICE]+mPARAN+', '+mAPI[mCHOICE]+" FUNCTION"
endi
xx=xx+2
@ xx, 0
RETURN
PROCEDURE CLR
if xx=23
xx=7
if yy=0
yy=yy+43
else
yy=0
@ 23,0
@ 23,0 say "Press any key to continue..."
inkey(0)
@ 7,51 clear to 23,79
endi
endi
RETURN
PROCEDURE CLR2
if xx=23
xx=5
if yy=0
yy=yy+43
else
yy=0
@ 23,0
@ 23,0 say "Press any key to continue..."
inkey(0)
@ 5,0 clear to 23,79
endi
endi
RETURN
PROCEDURE CHKRTNUM
PARAMETERS rtn
IF rtn<0
IF rtn=-251.AND.mSVC<>"BD"
@ 23,0 SAY ;
"Sorry, Novell did not include this service in this version of NetWare ... "
else
?"Error:", rtn
endi
ELSE
@ 23,0 SAY "Successful ! ... Use SYSCON to check."
ENDIF
WAIT
RETURN
PROCEDURE CHKRTNUM1
PARAMETERS rtn
IF rtn<0
IF rtn=-251.AND.mSVC<>"BD"
@ 23,0 SAY ;
"Sorry, Novell did not include this service in this version of NetWare ... "
else
?"Error:", rtn
endi
ELSE
@ 23,0 SAY "Successful ! ...."
ENDIF
WAIT
RETURN
PROCEDURE CHKRTNUM2
PARAMETERS rtn
IF rtn<0
IF rtn=-251.AND.mSVC<>"BD"
@ 23,0 SAY ;
"Sorry, Novell did not include this service in this version of NetWare ... "
else
?"Error:", rtn
WAIT
OK=.F.
endi
elseif mCNT
?"Count = ", LTRIM(STR(rtn))
WAIT
OK=.F.
ENDIF
RETURN
PROCEDURE CHKRTNUM3
PARAMETERS rtn
IF rtn<0
IF rtn=-251.AND.mSVC<>"BD"
@ 23,0 SAY ;
"Sorry, Novell did not include this service in this version of NetWare ... "
else
?"Error:", rtn
WAIT
OK=.F.
endi
ENDIF
RETURN
PROCEDURE CHKRTNUM4
PARAMETERS rtn
IF rtn<0
IF rtn=-251.AND.mSVC<>"BD"
@ 23,0 SAY ;
"Sorry, Novell did not include this service in this version of NetWare ... "
else
?"No, because:", rtn
endi
ELSE
@ 23,0 SAY "Yes ! ...."
ENDIF
WAIT
RETURN
PROCEDURE CHKRTNUM5
PARAMETERS rtn
IF asc(rtn)<32 .or. asc(rtn)>100
IF asc(rtn)=251.AND.mSVC<>"BD"
@ 23,0 SAY ;
"Sorry, Novell did not include this service in this version of NetWare ... "
else
?"Error:", -asc(rtn)
endi
ELSE
@ 23,0 SAY rtn
ENDIF
WAIT
RETURN
PROCEDURE CHKRTNUM6
PARAMETERS rtn
if valtype(rtn)='N'
IF rtn<0
IF rtn=-251.AND.mSVC<>"BD"
@ 23,0 SAY ;
"Sorry, Novell did not include this service in this version of NetWare ... "
ELSE
? "Error:", rtn
ENDI
ELSE
@ 23,0 SAY rtn
ENDIF
ELSE
@ 23,0 SAY rtn
ENDIF
WAIT
RETURN
PROCEDURE CHKRTNUM7
PARAMETERS rtn
IF rtn<0
IF rtn=-251.AND.mSVC<>"BD"
@ 23,0 SAY ;
"Sorry, Novell did not include this service in this version of NetWare ... "
ELSE
? "Error: ", rtn
ENDIF
ELSE
@ 23,0 SAY "Successful ! ... Use FILER to check."
ENDIF
WAIT
RETURN
PROCEDURE CHKRTNUM8
PARAMETERS rtn
IF if(valtype(rtn)='N',rtn,0)<0
IF rtn=-251.AND.mSVC<>"BD"
@ 23,0 SAY ;
"Sorry, Novell did not include this service in this version of NetWare ... "
ELSE
@ 23,0
?"Error:", rtn
ENDIF
ELSE
@ 23,0
@ 23,0 SAY if(valtype(rtn)='N',TRANS(rtn,"@B ###,###,###,###"),rtn)
ENDIF
WAIT
RETURN
PROCEDURE CHKRTNUM10
PARAMETERS rtn
IF rtn<0
IF rtn=-251.AND.mSVC<>"BD"
@ 23,0 SAY ;
"Sorry, Novell did not include this service in this version of NetWare ... "
else
?"Error:", rtn
endi
ELSE
@ 23,0 SAY "Successful ! ... Use SETTTS.EXE to check."
ENDIF
WAIT
RETURN